home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / PROBLEMS / BENCHMARK / BUBBLESORT / bubbletest / aforth / source < prev    next >
Text File  |  1992-05-17  |  1KB  |  50 lines
  1. \ A classical benchmark of an O(n**2) algorithm; Bubble sort
  2. \
  3. \ Part of the programs gathered by John Hennessy for the MIPS
  4. \ RISC project at Stanford. Translated to forth by Marty Fraeman
  5. \ Johns Hopkins University/Applied Physics Laboratory.
  6. \
  7. \ a little bit modified for bubblesort benchmark test on acorn archimedes
  8.  
  9. variable pseudorandom ( -- addr)
  10.  
  11. : cell ( -- numberofbytes per cell ) 4 ;
  12.  
  13. : initiate-pseudorandom ( -- )  123456 pseudorandom ! ;
  14. : random  ( -- n )  pseudorandom @ 234567 + 567 mod 345 + dup pseudorandom ! ;
  15.  
  16. 1000 constant elements ( -- int)
  17.  
  18. align create list elements cells allot
  19.  
  20. : initiate-list ( -- )
  21.   list elements cells + list do random i ! cell +loop
  22. ;
  23.  
  24. : dump-list ( -- )
  25.   list elements cells + list do i @ . cell cr +loop
  26. ;
  27.  
  28. : bubble-with-flag ( -- )
  29.   1 elements 1 do
  30.     true list elements i - cells over + swap do
  31.       i 2@ < if i 2@ swap i 2! drop false then
  32.     cell +loop 
  33.     if leave then
  34.   loop
  35. ;
  36.   
  37. : start ( -- )
  38.   initiate-pseudorandom
  39.   initiate-list
  40.   dump-list
  41.   s" <bubble_aforth$dir>.timer " cli
  42.   bubble-with-flag
  43.   s" <bubble_aforth$dir>.timer " cli
  44.   dump-list
  45. ;
  46.  
  47. start
  48.  
  49.  
  50.